SWAGOLX.EXE (c) 1993 GDSOFT ALL RIGHTS RESERVED 00005 DOS REDIRECTION ROUTINES 1 05-28-9313:56ALL SWAG SUPPORT TEAM DOS-REDR.PAS IMPORT 28 Unit Execute;ππInterfaceππProcedure Exec(Path,CmdLine : String);ππImplementationππUsesπ Dos;ππFunction ExtractFileName(Var Line : String;Index : Integer) : String;ππVarπ Temp : String;ππbeginπ Delete(Line,Index,1);π While (Index <= Length(Line)) and (Line[Index] = ' ')π Do Delete(Line,Index,1);π Temp := '';π While (Index <= Length(Line)) and (Line[Index] <> ' ') Doπ beginπ Temp := Temp + Line[Index];π Delete(Line,Index,1);π end;π ExtractFileName := Temp;πend;ππProcedure CloseHandle(Handle : Word);ππVarπ Regs : Registers;ππbeginπ With Regs Doπ beginπ AH := $3E;π BX := Handle;π MsDos(Regs);π end;πend;ππProcedure Duplicate(SourceHandle : Word;Var TargetHandle : Word);ππVarπ Regs : Registers;ππbeginπ With Regs Doπ beginπ AH := $45;π BX := SourceHandle;π MsDos(Regs);π TargetHandle := AX;π end;πend;ππProcedure ForceDuplicate(SourceHandle : Word;Var TargetHandle : Word);ππVarπ Regs : Registers;ππbeginπ With Regs Doπ beginπ AH := $46;π BX := SourceHandle;π CX := TargetHandle;π MsDos(Regs);π TargetHandle := AX;π end;πend;ππProcedure Exec(Path,CmdLine : String);ππVarπ StdIn : Word;π Stdout : Word;π Index : Integer;π FName : String[80];π InFile : Text;π OutFile : Text;ππ InHandle : Word;π OutHandle : Word;π { ===============>>>> } { change below For STDERR }πbeginπ StdIn := 0;π StdOut := 1; { change to 2 For StdErr }π Duplicate(StdIn,InHandle); { duplicate standard input }π Duplicate(StdOut,OutHandle); { duplicate standard output }π Index := Pos('>',CmdLine);π If Index > 0 Then { check For output redirection }π beginπ FName := ExtractFileName(CmdLine,Index); { get output File name }π Assign(OutFile,FName); { open a Text File }π ReWrite(OutFile); { .. For output }π ForceDuplicate(TextRec(OutFile).Handle,StdOut);{ make output same }π end;π Index := Pos('<',CmdLine);π If Index > 0 Then { check For input redirection }π beginπ FName := ExtractFileName(CmdLine,Index); { get input File name }π Assign(InFile,FName); { open a Text File }π Reset(InFile); { For input }π ForceDuplicate(TextRec(InFile).Handle,StdIn); { make input same }π end;π Dos.Exec(Path,CmdLine); { run EXEC }π ForceDuplicate(InHandle,StdIn); { put standard input back to keyboard }π ForceDuplicate(OutHandle,StdOut); { put standard output back to screen }π CloseHandle(InHandle); { Close the redirected input File }π CloseHandle(OutHandle); { Close the redirected output File }πend;ππend.ππ{===============================================================}π{πUse it exactly as you would the normal EXEC Procedure:ππ Exec('MAsm.EXE','mystuff.Asm');ππTo activate redirection simply add the redirection symbols, etc:ππ Exec('MAsm.EXE','mystuff.Asm >err.lst');ππOne note of caution. This routine temporarily Uses extra handles. It'sπeither two or four more. The Various books I have are not clear as toπwhether duplicated handles 'count' or not. My guess is yes. If you don'tπplan on redirecting STDIN then reMove all the code For duplicating it toπcut your handle overhead in half.π}ππ 2 05-28-9313:56ALL SWAG SUPPORT TEAM DUALOUT.PAS IMPORT 37 Unit dualout;ππ{ This Unit is designed to demonstrate directing all screen output to a File }π{ in addition to the normal display. This means that any Write or Writeln }π{ will display normally on the screen and also be Recorded in a Text File. }π{ The File name For the output can be supplied by a command line parameter }π{ in the Format - dual=c:\test\output.dat or you can provide an environment }π{ Variable named dual that supplies the File name or it will default to the }π{ current directory and output.dat. }ππInterfaceππUsesπ globals, { contains the Function exist, which tests For the existence of }π { a File. It also defines the Type str80 as String[80] }π Dos,π tpString; { from TPro. Needed For StUpCase Function in Procedure initialise}ππConst π DualOn : Boolean = False;π DualOK : Boolean = False;π fname : str80 = 'output.dat'; { The default File name For the output }π πTypeπ DriverFunc = Function(Var f: TextRec): Integer;ππVarπ OldExitProc : Pointer; { For saving old Exit Procedure }π OldInOutOutput, { The old output InOut Function }π OldFlushOutput : DriverFunc; { The old output Flush Function }π dualf : Text;ππProcedure dual(status: Boolean);ππ{===========================================================================}πImplementationππVarπ cmdline : String;π πProcedure DualWrite(Var f: TextRec);π { Writes the output from stdout to a File }π Varπ x : Word;π beginπ For x := 0 to pred(f.BufPos) doπ Write(dualf, f.BufPtr^[x]);π end; { DualWrite }ππ{$F+}πFunction InOutOutput(Var f: TextRec): Integer;π beginπ DualWrite(f); { Write to the File }π InOutOutput := OldInOutOutput(f); { Call the old Function }π end; { InOutOutput }ππFunction FlushOutput(Var f: TextRec): Integer;π beginπ DualWrite(f); { Write to the File }π FlushOutput := OldFlushOutput(f); { Call the old Function }π end; { FlushOutput }ππProcedure DualExitProc;π beginπ close(dualf);π ExitProc := OldExitProc; { Restore the old Exit Procedure }π With TextRec(output) do beginπ InOutFunc := @OldInOutOutput; { Restore the old output Record }π FlushFunc := @OldFlushOutput; { Restore the old flush Record }π end; { With }π end; { DualExitProc }ππ{$F-,I-}πProcedure dual(status: Boolean);π Varπ ErrorCode : Integer;π beginπ if status then beginπ assign(dualf,fname);π if Exist(fname) then { open For writing }π append(dualf)π else { start new File }π reWrite(dualf);π ErrorCode := Ioresult; π if ErrorCode <> 0 then π halt(ErrorCode);π With TextRec(output) do beginπ { This is where the old output Functions are rerouted }π OldInOutOutput := DriverFunc(InOutFunc);π OldFlushOutput := DriverFunc(FlushFunc);π InOutFunc := @InOutOutput;π FlushFunc := @FlushOutput;π end; { With }π OldExitProc := ExitProc; { Save the current Exit Procedure }π ExitProc := @DualExitProc; { Install new Exit Procedure }π DualOn := True;π end { if status } π else { switch dual output off } begin π if DualOn then beginπ close(dualf); if Ioresult = 0 then; { dummy call }π ExitProc := OldExitProc; { Restore the old Exit Procedure }π OldExitProc := nil;π With TextRec(output) do beginπ InOutFunc := @OldInOutOutput; { Restore the old output Record }π FlushFunc := @OldFlushOutput; { Restore the old flush Record }π end; { With }π end; { if DualOn }π end; { else }π end; { dual }π{$I+} πππProcedure Initialise;π { Determines if a File name For the output has been provided. }π beginπ if GetEnv('DUAL') <> '' thenπ fname := GetEnv('DUAL')π else beginπ if ParamCount <> 0 then beginπ cmdline := String(ptr(PrefixSeg,$80)^);π cmdline := StUpCase(cmdline);π if pos('DUAL=',cmdline) <> 0 then beginπ fname := copy(cmdline,pos('DUAL=',cmdline)+5,80);π if pos(' ',fname) <> 0 thenπ fname := copy(fname,1,pos(' ',fname)-1);π end; { if pos('Dual... }π end; { if ParamCount... }π end; { else }π end; { Initialise }π πbeginπ Initialise;πend. ππ 3 05-28-9313:56ALL SWAG SUPPORT TEAM REDIRCT1.PAS IMPORT 43 {πAll these solutions of using a shell to redirect output.ππThere are two Dos interrupts that allow Filehandles to be duplicated.ππRedirec and unredirec allow easy access to dup and dup2 For standard inπand out (input and output are reserved TP Words) to a Text File that youπhave previously opened (reset/reWrite/append as appropriate). It must beπopened - this allocates a File handle (a Byte - you declare this, you'llπneed it later to get your output back). if you don't unredirec to theπright handle you could loose all your output to the File or a black hole -πbe warned.ππYou could make similar Procedures to redirec/unredirec For redirection ofπother standard handles (3 is Printer (LST), 4 I think is STDERR and 5πis AUX aren't they?)ππHere's the Unit:π}ππ{$O+ $F+}ππUnit ReDIRECt;ππInterfaceππFunction dup (hand : Byte; Var error : Boolean) : Byte;π { provides a new handle For an already opened device or File.π if error, then the return is the error code - 4 no handles available orπ 6, invalid handle.}ππProcedure dup2 (source, destination : Byte; Var err : Byte);π { Makes two File handles refer to the same opened File at the sameπ location. The destination is closed first.π Err returns 0 if no error or error code as For dup.π to redirect then return to normal - do as follows:π 1. Use DUP to save the handle to be directed (the source).π 2. Assign and reWrite/reset the destination.π 3. Redirect the handle using DUP2.π 4. Do the execπ 5. Use dup2 again restoring the saved handle.π 6. reset/reWrite the redirected items & close the destination}ππFunction Redirec (op : Boolean; Var f:Text; Var hand : Byte) : Boolean;π {redirects standard out to (if op True) or standard in from File fn.π returns handle in handle to be used by undirec, below, and True ifπ successful.}ππProcedure Undirec (op : Boolean; hand : Byte);π {undoes the redirection from the previous redirec. Assumes File closedπ by caller.}ππFunction getFilehandle(Filename : String; Var error : Boolean) : Integer;ππ{////////////////////////////////////////////////////////////////////////}πImplementationππUsesπ Dos;ππFunction dup (hand : Byte; Var error : Boolean) : Byte;πVarπ regs : Registers;πbeginπ With regs doπ beginπ AH := $45;π BX := hand;ππ MsDos (regs);ππ error := flags and fcarry <> 0; {error if carry set}ππ dup := AX;π end;πend;ππProcedure dup2 (source, destination : Byte; Var err : Byte);πVarπ regs : Registers;πbeginπ With regs doπ beginπ AH := $46;π BX := source;π CX := destination ;ππ MsDos (regs);ππ if flags and fcarry <> 0 then {error if carry set}π err := AXπ elseπ err := 0;π end;πend;ππFunction Redirec (op : Boolean; Var f:Text; Var hand : Byte) : Boolean;π {redirects standard out to (if op True) or standard in from File fn.π returns handle in handle to be used by undirec, below, and True ifπ successful.}πVarπ err : Byte;π error : Boolean;πbeginπ redirec := False;π err := 0;π if op thenπ beginπ flush (output);π hand := dup (Textrec(output).handle, error)π endπ elseπ beginπ flush (input);π hand := dup (Textrec(input).handle, error)π end;π if error thenπ Exit;π {$i-}π if op thenπ reWrite (f)π elseπ reset (f);π {$i+}π if ioresult <> 0 thenπ Exit;π if op thenπ dup2 (Textrec(f).handle, Textrec(output).handle,err)π elseπ dup2 (Textrec(f).handle, Textrec(input).handle,err);ππ redirec := (err = 0);πend;ππProcedure Undirec (op : Boolean; hand : Byte);π {undoes the redirection from the previous redirec. Assumes File closedπ by caller.}πVarπ err : Byte;πbeginπ if op thenπ beginπ dup2 (hand, Textrec(output).handle, err);π reWrite (output)π endπ elseπ beginπ dup2 (hand, Textrec(input).handle, err);π reset (input)π endπend; {undirec}πππFunction getFilehandle( Filename : String; Var error : Boolean) : Integer;πVarπ regs : Registers;π i : Integer;πbeginπ Filename := Filename + #0;π fillChar(regs, sizeof(regs), 0);ππ With regs doπ beginπ ah := $3D;π AL := $00;π ds := seg(Filename);π dx := ofs(Filename) + 1;π end;ππ MsDos(Regs);ππ I := regs.ax;ππ if (lo(regs.flags) and $01) > 0 thenπ beginπ error := True;π getFilehandle := 0;π Exitπ end;ππ getFilehandle := i;πend;ππend.ππ{ Here's a demo }ππProgram dupdemo;ππ{$M 2000,0,0}πUsesπ Direc, Dos;πππVarπ arcname : String;π tempFile : Text;π op : Boolean;π handle : Byte;π Handle2 : Byte;π err : Boolean;π Error : Byte;π InFile : File;ππbeginπ Handle := 0;ππ Handle2 := Dup(Handle,Err);ππ if Err thenπ beginπ Writeln('Error getting another handle');π halt;π end;ππ arcname := 'C:\qmpro\download\qmpro102.ZIP';π assign (tempFile, 'C:\qmpro\download\TEMP.FIL');π ReWrite(TempFile);ππ Dup2(Handle, Handle2, Error);π if Error <> 0 thenπ beginπ Writeln('ERRor: ',Error);π Halt;π end;πππ if redirec(op, tempFile, handle2) thenπ beginπ SwapVectors;π Writeln('Running ZIP!');π Exec('PKUNZIP',' -V ' + ArcName);π SwapVectors;π close (tempFile);π undirec (op, handle2);π endπ elseπ Writeln('Error!');πend.ππ{πI wrote the DUPDEMO Program, but the Unit is the brainchild of an author that Iπcan't remember, but I use this regularly. It will work up to TP 7.0, I'veπnever tested it With TP 7.0 because I don't own it.π}ππ 4 05-28-9313:56ALL SWAG SUPPORT TEAM REDIRCT2.PAS IMPORT 14 {π> When pkzip executes... it Writes to the screen and scrolls myπ> screen up. Is there a way in which I can prevent pkzip from writingπ> to the screen.ππThis thread comes up a bunch. Here's a tried and tested solution :π}πUnit Redir;ππ{ Redirect input, output, and errors }ππInterfaceππProcedure RedirectInput (TextFile : String);πProcedure RedirectOutput (TextFile : String);πProcedure StdInput;πProcedure StdOutput;ππImplementationππUsesπ Dos;ππConstπ STDin = 0;π STdoUT = 1;π STDERR = 2;ππProcedure Force_Dup (Existing, { Existing handle }π Second : Word); { Handle to place it to }ππVarπ R : Registers;ππbeginππ r.AH := $46;π r.BX := Existing;π r.CX := Second;ππ MSDos (R);ππ if (r.Flags and FCarry) <> 0 thenπ Writeln ('Error ', r.AX, ' changing handle ', Second);πend;πππProcedure RedirectInput (TextFile : String);ππVarπ TF : Text;ππbeginπ Assign (TF, TextFile);π Reset (TF);π Force_Dup (TextRec (TF).Handle, STDin);πend;ππProcedure RedirectOutput (TextFile : String);ππVarπ TF : Text;ππbeginπ Assign (TF, TextFile);π ReWrite (TF);π Force_Dup (TextRec (TF).Handle, STdoUT);π Force_Dup (TextRec (TF).Handle, STDERR);πend;ππProcedure StdInput;ππbeginπ Assign (Input, '');π Reset (Input);πend;ππProcedure StdOutPut;ππbeginπ Assign (Output, '');π ReWrite (Output);πend;ππend.ππ{------ cut here ------}π{πIn your Program :ππUses Redir;ππbeginπ RedirectOutput ('LOGFile.OUT');π Exec ('PKZIP.EXE', '');π StdOutPut;πend.π} 5 05-28-9313:56ALL SWAG SUPPORT TEAM REDIRCT3.PAS IMPORT 32 {πMARK LEWISππ>> Still need a bit of help here. I can't redirect output from aπ>> Program when executing it from a Pascal Program! Is there anyπ>> this from Pascal? Any help would be greatly appreciated.π> if I understand you, you are using the Exec Procedure to run aπ> Program. if that is the Case you won't be ablr to redirect sinceπ> this is a Function of Dos and not the Program you exec. You willπ> need to run the Program through a child process in order toπ> perform the redirect, something like:π> Exec(GetEnv('COMSPEC'),'/C MyProg.exe>redirect');ππone could also utilize duplicate File handles -=B-)ππ}πUnit Execute;ππInterfaceππProcedure Exec(Path, CmdLine : String);ππImplementationππUsesπ Dos;ππFunction ExtractFileName(Var Line : String; Index : Integer) : String;πVarπ Temp : String;πbeginπ Delete(Line, Index, 1);π While (Index <= Length(Line)) and (Line[Index] = ' ') Doπ Delete(Line, Index, 1);π Temp := '';π While (Index <= Length(Line)) and (Line[Index] <> ' ') Doπ beginπ Temp := Temp + Line[Index];π Delete(Line, Index, 1);π end;π ExtractFileName := Temp;πend;ππProcedure CloseHandle(Handle : Word);πVarπ Regs : Registers;πbeginπ With Regs Doπ beginπ AH := $3E;π BX := Handle;π MsDos(Regs);π end;πend;ππProcedure Duplicate(SourceHandle : Word;Var TargetHandle : Word);πVarπ Regs : Registers;πbeginπ With Regs Doπ beginπ AH := $45;π BX := SourceHandle;π MsDos(Regs);π TargetHandle := AX;π end;πend;ππProcedure ForceDuplicate(SourceHandle : Word;Var TargetHandle : Word);πVarπ Regs : Registers;πbeginπ With Regs Doπ beginπ AH := $46;π BX := SourceHandle;π CX := TargetHandle;π MsDos(Regs);π TargetHandle := AX;π end;πend;ππProcedure Exec(Path,CmdLine : String);πVarπ StdIn,π Stdout : Word;π Index : Integer;π FName : String[80];π InFile,π OutFile : Text;π InHandle,π OutHandle : Word;π { ===============>>>> } { change below For STDERR }πbeginπ StdIn := 0;π StdOut := 1; { change to 2 For StdErr }π Duplicate(StdIn, InHandle); { duplicate standard input }π Duplicate(StdOut, OutHandle); { duplicate standard output }π Index := Pos('>', CmdLine);π if Index > 0 Then { check For output redirection }π beginπ FName := ExtractFileName(CmdLine, Index); { get output File name }π Assign(OutFile, FName); { open a Text File }π ReWrite(OutFile); { .. For output }π ForceDuplicate(TextRec(OutFile).Handle, StdOut);{ make output same }π end;π Index := Pos('<', CmdLine);π if Index > 0 Then { check For input redirection }π beginπ FName := ExtractFileName(CmdLine, Index); { get input File name }π Assign(InFile, FName); { open a Text File }π Reset(InFile); { For input }π ForceDuplicate(TextRec(InFile).Handle, StdIn); { make input same }π end;π Dos.Exec(Path, CmdLine); { run EXEC }π ForceDuplicate(InHandle, StdIn); { put standard input back to keyboard }π ForceDuplicate(OutHandle, StdOut); { put standard output back to screen }π CloseHandle(InHandle); { close the redirected input File }π CloseHandle(OutHandle); { close the redirected output File }πend;ππend.ππ{===============================================================}π{πUse it exactly as you would the normal EXEC Procedure:ππ Exec('MAsm.EXE','mystuff.Asm');ππTo activate redirection simply add the redirection symbols, etc:ππ Exec('MAsm.EXE','mystuff.Asm >err.lst');πππOne note of caution. This routine temporarily Uses extra handles. It'sπeither two or four more. The Various books I have are not clear as toπwhether duplicated handles 'count' or not. My guess is yes. if you don'tπplan on redirecting STDIN then remove all the code For duplicating it toπcut your handle overhead in half.π}ππ
